home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / gmhist-mh.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  13.7 KB  |  355 lines
  1. ;;;; gmhist-mh.el - emulate proposed Emacs 19 builtin Minibuffer History
  2. ;;;; Id: gmhist-mh.el,v 4.8 1991/09/20 13:15:40 sk RelBeta 
  3.  
  4. ;;;; This package redefines the functions
  5. ;;;;
  6. ;;;;     read-string
  7. ;;;;     completing-read
  8. ;;;;     write-region
  9. ;;;;     delete-file
  10. ;;;;     read-buffer
  11. ;;;;     read-file-name
  12. ;;;;     switch-to-buffer
  13. ;;;;
  14. ;;;; to implement the variables
  15. ;;;;
  16. ;;;;     minibuffer-history-symbol
  17. ;;;;     file-history-symbol
  18. ;;;;     buffer-history-symbol
  19. ;;;;     buffer-history-lru-order
  20. ;;;;     max-minibuffer-history-length
  21. ;;;;
  22. ;;;; and the hooks
  23. ;;;;
  24. ;;;;    after-write-region-hook
  25. ;;;;    after-delete-file-hook
  26.  
  27. (require 'gmhist)
  28. (provide 'gmhist-mh)
  29.  
  30. (defvar max-minibuffer-history-length 'not-implemented)
  31.  
  32. ;;;; Redefining basic Emacs functions
  33.  
  34. (defun gmhist-overwrite (fun)
  35.   ;; Overwrite FUN (a symbol, the name of a function) with gmhist-new-FUN.
  36.   ;; Save the old def of FUN in gmhist-old-FUN.
  37.   ;; Conventions: gmhist-FUN emulates FUN, but with history.
  38.   ;;           gmhist-new-FUN may take additional care of the case
  39.   ;;           that history is disabled before calling gmhist-FUN
  40.   ;;           to do the real work.
  41.   (let* ((fun-name (symbol-name fun))
  42.      (old-name (intern (concat "gmhist-old-" fun-name)))
  43.      (new-name (intern (concat "gmhist-new-" fun-name))))
  44.     (or (fboundp old-name)
  45.     (fset old-name (symbol-function fun)))
  46.     (fset fun new-name)))
  47.  
  48. ;;; Minibuffer history (not specialized like file or buffer history)
  49.  
  50. ;;; Should perhaps modify minibuffer keymaps directly:
  51. ;;; minibuffer-local-completion-map
  52. ;;; minibuffer-local-map
  53. ;;; minibuffer-local-must-match-map
  54. ;;; minibuffer-local-ns-map
  55.  
  56. (defun gmhist-new-read-string (gnrs-prompt &optional initial-input)
  57.   "Read a string from the minibuffer, prompting with string PROMPT.
  58. If non-nil second arg INITIAL-INPUT is a string to insert before reading.
  59. See also `minibuffer-history-symbol'."
  60.   (if minibuffer-history-symbol
  61.       (gmhist-read-from-minibuffer gnrs-prompt initial-input gmhist-map)
  62.     (gmhist-old-read-string gnrs-prompt initial-input)))
  63.  
  64. (gmhist-overwrite 'read-string)
  65.  
  66. (defun gmhist-new-completing-read
  67.   (gncr-prompt table &optional predicate mustmatch initial)
  68.   "Read a string in the minibuffer, with completion and history.
  69. Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.
  70. PROMPT is a string to prompt with; normally it ends in a colon and a space.
  71. TABLE is an alist whose elements' cars are strings, or an obarray (see
  72.   try-completion).
  73. PREDICATE limits completion to a subset of TABLE see try-completion
  74.   for details.
  75. If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
  76.  the input is (or completes to) an element of TABLE.
  77.  If it is also not t, Return does not exit if it does non-null completion.
  78. If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
  79. Case is ignored if ambient value of  completion-ignore-case  is non-nil.
  80.  
  81. *** This is the gmhist version ***
  82. See variable `minibuffer-history-symbol'."
  83.   (if minibuffer-history-symbol
  84.       (gmhist-completing-read gncr-prompt table predicate mustmatch initial)
  85.     (gmhist-old-completing-read gncr-prompt table predicate mustmatch initial)))
  86.  
  87. (gmhist-overwrite 'completing-read)
  88.  
  89. ;;; File history
  90.  
  91. (defvar file-history (get file-history-symbol 'initial-hist)
  92.   "Default history of file names read with read-file-name.
  93. This symbol is the default value of file-history-symbol (q.v.).")
  94.  
  95. (defvar insert-file-default nil
  96.   "*If non-nil, defaults for filenames will be inserted into the
  97. minibuffer prompt.  This has the advantage of putting the default onto
  98. the file-history (which see).")
  99.  
  100. (defun gmhist-new-read-file-name (gnrfn-prompt
  101.                   &optional dir default mustmatch initial)
  102.     "Read file name, maintaining history in value of
  103. file-history-symbol, prompting with PROMPT, completing in directory DIR.
  104.  
  105. Value is not expanded!  You must call expand-file-name yourself.
  106.  
  107. Default name to third arg DEFAULT if user enters a null string.
  108. \(If DEFAULT is omitted, the visited file name is used.)
  109.  
  110. Fourth arg MUSTMATCH non-nil means require existing file's name.
  111. Non-nil and non-t means also require confirmation after completion.
  112.  
  113. Fifth arg INITIAL specifies text to start with.
  114. DIR defaults to current buffer's default-directory.
  115.  
  116. *** This is the gmhist version ***
  117.  
  118. It differs from the original read-file-name in providing a
  119. history of filenames in the variable whose name is the value of
  120. file-history-symbol (usually 'file-history) (both of which see).
  121.  
  122. INITIAL defaults to default-directory's value if
  123. insert-default-directory is non-nil.  Also, if insert-file-default is
  124. non-nil, it inserts the DEFAULT string if no INITIAL is given, which
  125. has the advantage of putting the default onto the file-history.
  126. However, setting INITIAL to a string is a way for providing an
  127. editable default, something not possible with (pre Emacs-19)
  128. read-file-name.  Setting INITIAL and insert-default-directory to nil
  129. will yield a basename for the file, relative to default-directory.
  130.  
  131. See function read-with-history-in for a list of properties you can put
  132. on file-history-symbol."
  133.     (if (null file-history-symbol)
  134.     (gmhist-old-read-file-name gnrfn-prompt dir default mustmatch)
  135.       (gmhist-read-file-name gnrfn-prompt dir default mustmatch
  136.                  (if (and insert-file-default
  137.                       (not initial))
  138.                  default
  139.                    initial))))
  140.  
  141. ;; It is a shame that none of the standard hooks are defvar'd!
  142. ;; Also, the coexistence of `hooks' vs `hook' is annoying.
  143. ;; The singular seems to be the majority, so I'll use that.
  144.  
  145. (defvar after-write-region-hook nil
  146.   "Run after the gmhist version of `write-region'.
  147. The variables `start', `end', `filename', `append', `visit' are bound
  148. around the call to the hook.")
  149.  
  150. ;; Don't use &rest args, as the hook may want to take advantage of our
  151. ;; arglist.
  152. (defun gmhist-new-write-region (start end filename
  153.                       &optional append visit)
  154.   "Write current region into specified file.
  155. When called from a program, takes three arguments:
  156. START, END and FILENAME.  START and END are buffer positions.
  157. Optional fourth argument APPEND if non-nil means
  158.   append to existing file contents (if any).
  159. Optional fifth argument VISIT if t means
  160.   set last-save-file-modtime of buffer to this file's modtime
  161.   and mark buffer not modified.
  162. If VISIT is neither t nor nil, it means do not print
  163.   the \"Wrote file\" message.
  164.  
  165. *** This is the gmhist version ***
  166. See variable `after-write-region-hook'."
  167.   (interactive "r\nFWrite region to file: ")
  168.   (prog1
  169.       (gmhist-old-write-region start end filename append visit)
  170.     (condition-case err
  171.     ;; basic-save-buffer would assume an error to mean
  172.     ;; write-region failed
  173.     (run-hooks 'after-write-region-hook)
  174.       (error (message "Error in after-write-region-hook %s" err)
  175.          (sit-for 1)))))
  176.  
  177. (defvar after-delete-file-hook nil
  178.   "Run after the gmhist version of `delete-file'.
  179. The hook is run with `filename' bound to the filename.")
  180.  
  181. (defun gmhist-new-delete-file (filename)
  182.   "Delete specified file.  One argument, a file name string.
  183. If file has multiple names, it continues to exist with the other names.
  184.  
  185. *** This is the gmhist version ***
  186. See variable `after-delete-file-hook'."
  187.   (interactive "fDelete file: ")
  188.   (prog1
  189.       (gmhist-old-delete-file filename)
  190.     (condition-case err
  191.     ;; We don't want callers to assume an error in the hook to
  192.     ;; mean delete-file failed - or do we?
  193.     (run-hooks 'after-delete-file-hook)
  194.       (error (message "Error in after-delete-file-hook %s" err)
  195.          (sit-for 1)))))
  196.  
  197. (gmhist-overwrite 'read-file-name)
  198. (gmhist-overwrite 'write-region)
  199. (gmhist-overwrite 'delete-file)
  200.  
  201. ;; Redefining read-file-name does not suffice as interactive "f"
  202. ;; calls the C version of read-file-name.
  203. ;; gmhist-interactive of gmhist.el,v 4.4 and later understands the
  204. ;; indirection from file-history-symbol to 'file-history (or whatever
  205. ;; the current value may be).
  206. (gmhist-make-magic 'find-file              'file-history-symbol)
  207. (gmhist-make-magic 'find-file-other-window 'file-history-symbol)
  208. (gmhist-make-magic 'find-file-read-only    'file-history-symbol)
  209. (gmhist-make-magic 'insert-file            'file-history-symbol)
  210. (gmhist-make-magic 'load-file              'file-history-symbol)
  211. (gmhist-make-magic 'set-visited-file-name  'file-history-symbol)
  212. (gmhist-make-magic 'append-to-file         'file-history-symbol)
  213. ;; write-region is wrapped by gmhist, no longer a subr, thus this works:
  214. (gmhist-make-magic 'write-region           'file-history-symbol)
  215. ;; ditto for delete-file:
  216. (gmhist-make-magic 'delete-file            'file-history-symbol)
  217. (if gmhist-emacs-19-p
  218.     ;; In Emacs 19, these call the redefined read-file-name inside
  219.     ;; interactive, so we don't need to do anything
  220.     nil
  221.   (gmhist-make-magic 'write-file           'file-history-symbol)
  222.   (gmhist-make-magic 'find-alternate-file  'file-history-symbol))
  223.  
  224.  
  225. ;;; Buffer history
  226.  
  227. (defvar buffer-history-lru-order nil
  228.   "*If non-nil, the buffer history will be the complete buffer
  229. list in most recently used order (as returned by buffer-list).
  230.  
  231. Usually, the buffer history is in the order entered using read-buffer.")
  232.  
  233. (defvar buffer-history (get 'buffer-history 'initial-hist)
  234.   "History of all buffer names read with read-buffer.")
  235.  
  236. (defun gmhist-new-read-buffer (gnrb-prompt &optional default existing)
  237.   "One arg PROMPT, a string.  Read the name of a buffer and return as a string.
  238. Prompts with PROMPT.
  239. Optional second arg is value to return if user enters an empty line.
  240. If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.
  241.  
  242. *** This is the gmhist version ***
  243.  
  244. See variables `buffer-history-symbol' and `buffer-history-lru-order'."
  245.   (if (and buffer-history-symbol
  246.        buffer-history-lru-order)
  247.       (set buffer-history-symbol
  248.        (mapcar (function buffer-name) (buffer-list))))
  249.   (gmhist-read-buffer gnrb-prompt default existing))
  250.  
  251. (defun gmhist-new-switch-to-buffer (buffer &optional norecord)
  252.   "Select buffer BUFFER in the current window.
  253. BUFFER may be a buffer or a buffer name.
  254. Optional second arg NORECORD non-nil means
  255. do not put this buffer at the front of the list of recently selected ones.
  256.  
  257. WARNING: This is NOT the way to work on another buffer temporarily
  258. within a Lisp program!  Use `set-buffer' instead.  That avoids messing with
  259. the window-buffer correspondences.
  260.  
  261. *** This is the gmhist version ***
  262.  
  263. It adds buffer-history to switch-to-buffer."
  264.   (interactive
  265.    ;; should perhaps bypass gmhist if NORECORD is given?
  266.    (list (gmhist-new-read-buffer "Switch to buffer: " (other-buffer) nil)))
  267.   (gmhist-old-switch-to-buffer buffer norecord))
  268.  
  269. (gmhist-overwrite 'read-buffer)
  270. ;; switch-to-buffer is a subr:
  271. (gmhist-overwrite 'switch-to-buffer)
  272. ;; Redefining read-buffer does not suffice as interactive "b"
  273. ;; calls the C version of read-buffer.
  274. ;; gmhist-interactive of gmhist.el,v 4.4 and later understands the
  275. ;; indirection from buffer-history-symbol to 'buffer-history (or
  276. ;; whatever the current value may be).
  277. (mapcar (function (lambda (fun)
  278.             (gmhist-make-magic fun 'buffer-history-symbol)))
  279.     '(switch-to-buffer-other-window ; files.el
  280.       append-to-buffer        ; the rest from simple.el
  281.       prepend-to-buffer
  282.       copy-to-buffer))
  283.  
  284.  
  285. ;;; read-from-minibuffer
  286. ;;; saved and defined in gmhist.el, just need to overwrite:
  287.  
  288. (fset 'read-from-minibuffer 'gmhist-new-read-from-minibuffer)
  289.  
  290. ;; Now that we've redefined read-from-minibuffer we need to make sure
  291. ;; that repeat-complex-command (C-x ESC), which calls
  292. ;; read-from-minibuffer, adds the command to command-history and not
  293. ;; to the ambient value of minibuffer-history-symbol.  The latter
  294. ;; could be confusing if e.g. inside a C-x C-f a C-x ESC is done (with
  295. ;; enable-recursive-minibuffers t): it would add a command to the
  296. ;; file-history.
  297.  
  298. ;(defun repeat-complex-command (repeat-complex-command-arg)
  299. ;  "Edit and re-evaluate last complex command, or ARGth from last.
  300. ;A complex command is one which used the minibuffer.
  301. ;The command is placed in the minibuffer as a Lisp form for editing.
  302. ;The result is executed, repeating the command as changed.
  303. ;If the command has been changed or is not the most recent previous command
  304. ;it is added to the front of the command history.
  305. ;Whilst editing the command, the following commands are available:
  306. ;\\{repeat-complex-command-map}"
  307. ;  (interactive "p")
  308. ;  (let ((elt (nth (1- repeat-complex-command-arg) command-history))
  309. ;    newcmd)
  310. ;    (if elt
  311. ;    (progn
  312. ;      (setq newcmd
  313. ;        (let ((minibuffer-history-symbol nil))
  314. ;          ;; Don't let gmhist interfere with command-history.
  315. ;          ;; command-history is special because it's builtin to M-x.
  316. ;          ;; Also, gmhist would store commands as strings, not
  317. ;          ;; as s-exprs.
  318. ;          ;; When gmhist is implemented in C, M-x must be
  319. ;          ;; fixed to store strings, too.
  320. ;          (read-from-minibuffer "Redo: "
  321. ;                    (prin1-to-string elt)
  322. ;                    repeat-complex-command-map
  323. ;                    t)))
  324. ;      ;; If command to be redone does not match front of history,
  325. ;      ;; add it to the history.
  326. ;      (or (equal newcmd (car command-history))
  327. ;          (setq command-history (cons newcmd command-history)))
  328. ;      (eval newcmd))
  329. ;      (ding))))
  330.  
  331. ;; Actually, it's easier to just use the gmhist re-implementation instead
  332. (define-key ctl-x-map "\e" 'gmhist-repeat-complex-command)
  333.  
  334. (defun gmhist-repeat-complex-command (arg) ; C-x ESC
  335.   ;; This function from Mike Williams <Mike.Williams@comp.vuw.ac.nz>
  336.   "Edit and re-evaluate last complex command, or ARGth from last.
  337. A complex command is one which used the minibuffer.
  338. The command is placed in the minibuffer as a Lisp form for editing.
  339. The result is executed, repeating the command as changed.
  340. If the command has been changed or is not the most recent previous command
  341. it is added to the front of the command history."
  342.   (interactive "p")
  343.   (let ((print-escape-newlines t))
  344.     (put 'command-history 'backup arg)
  345.     (put 'command-history 'cursor-end t)
  346.     (eval (read-with-history-in 'command-history "Redo: " nil 'lisp))
  347.     (put 'command-history 'backup nil)))
  348.  
  349. ;; TODO:
  350. ;; read-minibuffer
  351. ;; eval-minibuffer
  352. ;; read-no-blanks-input
  353. ;; read-command
  354. ;; read-variable
  355.